home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMIBEST4.ADF / AmigaBasicStuff / Switch.MSB (.txt) < prev    next >
AmigaBASIC Source Code  |  1987-07-22  |  8KB  |  349 lines
  1.  'Swichbox  for 512 Amiga
  2.  'set Preferences for 80 columns
  3.  
  4.   Restart:
  5.   CLEAR: GOSUB Setup
  6.   
  7.   Main:
  8.   FOR round= 1 TO 4
  9.   PUT (80,7+round *8), ball
  10.   PUT (515,7+round *8), ball
  11.   GOSUB Values
  12.   SAY TRANSLATE$(intro$(round))
  13.   
  14.   Keepgoing:         
  15.   who =1-who
  16.   GOSUB Taketurn
  17.   IF SC(1-who,round)=> points(round,0) THEN Nextround
  18.   GOTO Keepgoing
  19.   
  20.   Nextround:
  21.   FOR j=0 TO 1: FOR k=5 TO 8
  22.   SC(j,k)= 0:NEXT:NEXT
  23.   FOR j=0 TO 1: FOR k=1 TO 4
  24.   gx=points(k,0): ac=SC(j,k)
  25.   SC(j,5)= SC(j,5) +ac
  26.   SC(j,6)= SC(j,6) -(ac=>gx)*gx
  27.   SC(j,7)= SC(j,7) +SC(j,k) -SC(1-j,k)
  28.   NEXT:NEXT
  29.   FOR j=0 TO 1: FOR k=6 TO 7
  30.   SC(j,k)= SC(j,k) +SC(j,5) 
  31.   NEXT:NEXT
  32.   FOR j=0 TO 1: FOR k=5 TO 7
  33.   SC(j,8)= SC(j,8)+ SC(j,k)
  34.   NEXT:NEXT
  35.   FOR j=0 TO 1
  36.   FOR k=5 TO 8: y$= STR$(SC(j,k))
  37.   x=LEN(y$): tx=8+j*64-x: ty=4+k
  38.   LOCATE ty,tx-1:PRINT SPACE$(2)
  39.   LOCATE ty,tx: PRINT y$
  40.   NEXT:NEXT
  41.   NEXT round
  42.   
  43.   GoHome:
  44.   LINE(240,70)-(362,100),2,bf
  45.   LOCATE 11,32:PRINT "Play again?"
  46.   text$= who$(ABS(SC(1,8)>SC(0,8)))
  47.   text$= text$ +" wins this game."
  48.   text$= text$ +"How about another?"
  49.   SAY TRANSLATE$(text$), voice%
  50.   FOR j= 0 TO 10: x$=INKEY$:NEXT
  51.   
  52.   Again:
  53.   x$=INKEY$: IF x$="" THEN Again
  54.   SAY TRANSLATE$( "OK."), voice%
  55.   IF x$="y" OR x$="Y" THEN WINDOW CLOSE 2: GOTO Restart
  56.   SAY TRANSLATE$( "Bye-bye."), voice%
  57.   WINDOW CLOSE 2
  58.   END
  59.   
  60.   Taketurn:
  61.   FOR j=0 TO nb: LB(j,0)=0: NEXT: nb=1
  62.   SAY TRANSLATE$( who$(who) + CHR$(46))
  63.   PUT(140,5),larrow: PUT(440,5),rarrow
  64.   FOR j=0 TO 9: x$=INKEY$:NEXT
  65.   
  66.   Getkey:
  67.   a$=INKEY$: IF a$="-" THEN RETURN
  68.   IF a$= "+" THEN a$=STR$(INT(RND(1)*8+1))
  69.   a=VAL(a$): IF (a<1) OR (a>8) THEN Getkey
  70.   LB(0,0)=1
  71.   FOR j= 1TO 3: LB(0,j)=0: NEXT
  72.   LB(0,4)= a+3
  73.   
  74.   Moreballs:
  75.   ex=1: FOR j=0TO nb
  76.   IF LB(j,0)THEN ex=0: GOSUB Moveone
  77.   NEXT: IF ex=0THEN Moreballs
  78.   x=0: FOR j=13 TO 7 STEP -3: FOR k=x TO 15-x
  79.   PUT (column(k),row(j) +1), blank, AND
  80.   NEXT: x=x+1: NEXT: RETURN
  81.   
  82.   Moveone:
  83.   dy=LB(j,0): dx=LB(j,1): ly=LB(j,2)
  84.   ny=LB(j,3): nx=LB(j,4)
  85.   IF ny THEN
  86.   PUT (column(nx),row(ny+(ly*3)) +1), blank, AND
  87.   END IF
  88.   LB(j,3)=(ny+1) MOD 3
  89.   ON ny+1 GOTO Pos0,Pos1,Pos2
  90.   
  91.   Pos0:
  92.   IF ly>4 THEN LB(j,0)=0: GOTO Score
  93.   vx=0: GOSUB Whichway
  94.   IF (sw(wx,wy,1)) AND (sw(wx,wy,0) =sd) THEN
  95.   vx=1-2*sd:LB(j,3)=ny+1:LB(j,4)=nx+vx
  96.   GOTO Putball
  97.   END IF
  98.   IF sw(wx,wy,0)=sd THEN
  99.   LB(j,0)=0
  100.   sw(wx,wy,1)=1: ny=ny+1
  101.   GOTO Putball
  102.   END IF
  103.   LB(j,3)=ny+1: GOTO Putball
  104.   
  105.   Pos1:
  106.   LB(j,1)=0: LB(j,4)=nx+dx: GOTO Putball
  107.   
  108.   Pos2:
  109.   LB(j,2)=ly +1: GOSUB Whichway
  110.   sw(wx,wy,0)= 1- sw(wx,wy,0)
  111.   IF sw(wx,wy,1) THEN
  112.   PUT(column(LB(j,4)+1-sd*2),row(ny+(ly*3))), blank, AND
  113.   LB(nb,0)=1:LB(nb,1)=0:LB(nb,2)=ly
  114.   LB(nb,3)=0:LB(nb,4)=nx+1-sd*2:nb=nb+1
  115.   sw(wx,wy,1)=0
  116.   END IF
  117.   sx= xpos(wx,wy): sy=ypos(wx,wy)
  118.   wp=sw(wx,wy,0)
  119.   
  120.   Switch:
  121.   PUT (sx,sy), swblank, AND
  122.   ON wp+1 GOTO Left,Right
  123.   Left:
  124.   PUT (sx,sy), lswitch, OR: GOTO Bop
  125.   Right:
  126.   PUT(sx,sy),rswitch, OR
  127.   Bop:
  128.   SOUND 100,1,64,who
  129.   SOUND 250,1,64,3-who
  130.   RETURN
  131.   
  132.   Putball:
  133.   SOUND INT(RND(1)*10)*(30*ly)+ 200,1,64,who
  134.   PUT(column(nx),row(ny+(ly*3)+1)), ball,OR
  135.   RETURN
  136.   
  137.   Whichway:
  138.   wx=ly:wy=INT((nx+ly-4)/2):sd=(nx+ly) AND 1:RETURN
  139.   
  140.   Score:
  141.   sf=points(round,nx+1):sg=SC(who,round)+sf
  142.   tx=8+63*who+(sg>9)+(sg>99)+(sg>999)
  143.   ty=2+round:a$=MID$(STR$(sg),2)
  144.   LOCATE ty,tx:PRINT a$
  145.   SC(who,round)=sg
  146.   FOR j=1600 TO 200 STEP-300
  147.   SOUND j,1,64,who
  148.   SOUND j+400,1,64,3-who
  149.   NEXT:RETURN
  150.   
  151.   Values:
  152.   FOR j=0 TO 1
  153.   k=2+70*j: LOCATE 15,k
  154.   PRINT SPACE$(3): LOCATE 15,k
  155.   PRINT RIGHT$(STR$(points(round,0)),3)
  156.   NEXT
  157.   FOR j=1 TO 16:k=points(round,j)
  158.   m=6+j*3.75
  159.   IF k>9 THEN
  160.   x= INT(k/10)
  161.   x$= MID$(STR$(x),2,1)
  162.   ELSE
  163.   x$=CHR$(32)
  164.   END IF
  165.   LOCATE 22,m:PRINT x$;
  166.   LOCATE 23,m:PRINT RIGHT$(STR$(k),1);
  167.   NEXT:RETURN
  168.   
  169.   Setup:
  170.   RANDOMIZE TIMER
  171.   DIM voice%(8)
  172.   FOR j=0TO 8
  173.   READ voice%(j):NEXT
  174.   DATA 110,0,150,0,22200,64,10,1,0
  175.   Greet$="Hi. Welcome to Switchbox."
  176.   PRINT Greet$
  177.   SAY TRANSLATE$(Greet$),voice%
  178.   SCREEN 2,640,200,2,2
  179.   PALETTE 0,0,0,0
  180.   PALETTE 1,1,1,1
  181.   PALETTE 2,0,0.1,0.7
  182.   PALETTE 3,1,1,0.13
  183.   WINDOW 2,"Switchbox",,0
  184.   DIM larrow(30),rarrow(30),wav%(256),lefthunk(400)
  185.   DIM righthunk(400),swblank(100),rswitch(200)
  186.   DIM lswitch(200),column(16),row(25)
  187.   DIM blank(70),ball(60),piece(80)
  188.   DIM sw(8,8,1),LB(32,4),points(4,16),SC(1,8)
  189.   FOR j=0 TO 10:LINE (0,5)-(10,j),3
  190.   NEXT
  191.   LINE (10,3)-(20,7),3,bf
  192.   GET(0,0)-(20,10), larrow
  193.   PUT(0,0),larrow
  194.   FOR j=1 TO 10
  195.   LINE (20,5)-(10,j),3
  196.   NEXT
  197.   LINE (0,3)-(10,7),3,bf
  198.   GET(0,0)-(20,10), rarrow
  199.   PUT(0,0),rarrow
  200.   GET(8,2)-(22,9),blank
  201.   CIRCLE(15,4),7,1
  202.   PAINT (16,4),1
  203.   GET(8,0)-(22,9),ball
  204.   PUT(8,0),ball
  205.   FOR j= 0 TO 127:wav%(j)= -127
  206.   wav%(j=128)=127: NEXT
  207.   FOR j=0 TO 3: WAVE j, wav%
  208.   NEXT
  209.   DATA 10,"round 1. equal scores."
  210.   DATA 2,2,2,2,2,2,2,2
  211.   DATA 40,"round 2. fibonachie sequence."
  212.   DATA 1,2,3,5,8,13,21,34
  213.   DATA 20,"round 3. arithmetic sequence."
  214.   DATA 2,3,4,5,6,7,8,9
  215.   DATA 80,"round 4. sequence of squares."
  216.   DATA 1,4,9,16,25,36,49,64
  217.   FOR j=1 TO 4: READ points(j,0)
  218.   READ intro$(j)
  219.   FOR k=1 TO 8:READ x
  220.   points(j,k+8)=x: points(j,9-k)=x
  221.   NEXT k: NEXT j
  222.   a=215: b=2
  223.   FOR j= 0TO 4
  224.   a=a-30: b=b+30
  225.   FOR k=0 TO j+3
  226.   xpos(j,k)= a+k*60
  227.   ypos(j,k)=b
  228.   NEXT:NEXT
  229.   k=0
  230.   FOR j=70 TO 520 STEP 30
  231.   column(k)=j
  232.   k=k+1:NEXT
  233.   k=0
  234.   FOR j=4 TO 154 STEP 10
  235.   row(k)=j: k=k+1:NEXT
  236.   
  237.   Start:
  238.   SAY TRANSLATE$("First player's name?"),voice%
  239.   INPUT"Name of player 1";p0$
  240.   SAY TRANSLATE$("Second player's name?"),voice%
  241.   INPUT"Name of player 2";p1$
  242.   who$(0)=LEFT$(p0$,6):who$(1)=LEFT$(p1$,6)
  243.   text$= who$(0)+ " plays " + who$(1)+ ". Is this correct"
  244.   PRINT text$;
  245.   SAY TRANSLATE$(text$),voice%
  246.   INPUT query$: an$= LEFT$(query$,1)
  247.   IF LEN(an$)=0 OR an$="y" OR an$="Y" THEN Draw
  248.   GOTO Start
  249.   
  250.   Draw:
  251.   SAY TRANSLATE$("Oh Kay."),voice%
  252.   CLS
  253.   LOCATE 1,6:PRINT who$(0)
  254.   LOCATE 1,66:PRINT who$(1)
  255.   x=4: FOR j=0 TO 1
  256.   LINE(x,12)-(x+110,60),2,bf
  257.   LINE(x+6,10)-(x+120,58),3,bf
  258.   LINE(x+16,14)-(x+110,48),0,bf
  259.   x=x+480:NEXT
  260.   x=1: FOR j=24 TO 50 STEP 3.7
  261.   LOCATE 2,j: PRINT x
  262.   x=x+1: NEXT
  263.   LINE(180,0)-(182,40),,bf
  264.   GET (180,0)-(182,40),piece
  265.   LINE(180,0)-(420,0)
  266.   FOR j=210 TO 420 STEP 60
  267.   LINE(j,0)-(j+2,12),,bf
  268.   PUT (j,40),piece
  269.   PUT (j,100),piece
  270.   NEXT
  271.   FOR j=180 TO 420 STEP 60
  272.   PUT (j,0),piece,OR
  273.   PUT (j,70),piece
  274.   PUT (j,126),piece
  275.   NEXT
  276.   PUT (120,126),piece 
  277.   PUT (150,100),piece 
  278.   PUT (450,100),piece 
  279.   PUT (480,126),piece 
  280.   ERASE piece
  281.   FOR j=30 TO 570 STEP 30
  282.   LINE(j,155)-(j+2,170),1,bf
  283.   NEXT
  284.   LINE(176,4)-(186,32),2,bf
  285.   LINE(416,4)-(426,32),2,bf
  286.   LINE(176,32)-(156,42),2 
  287.   LINE STEP(0,0)-STEP(-10,0),2
  288.   LINE STEP(0,0)-STEP(35,-32),2
  289.   PAINT(175,31),2
  290.   LINE(426,32)-(446,42),2
  291.   LINE STEP(0,0)-STEP(10,0),2
  292.   LINE STEP(0,0)-STEP(-36,-32),2
  293.   PAINT(427,32),2
  294.   GET(136,12)-(186,69),lefthunk
  295.   GET(416,12)-(456,62),righthunk 
  296.   l=106:r=446:k=42
  297.   FOR j=1TO 4
  298.   PUT(l,k),lefthunk,OR
  299.   PUT(r,k),righthunk,OR
  300.   l=l-30:r=r+30:k=k+30
  301.   NEXT
  302.   ERASE lefthunk,righthunk
  303.   LINE(26,153)-(36,165),2,bf
  304.   LINE(564,153)-(576,165),2,bf
  305.   GET(245,32)-(299,40),swblank
  306.   FOR j=0 TO 18
  307.   LINE(270+j,40)-(280+j,32),3
  308.   NEXT
  309.   LINE(245,39)-(280,40),3,bf
  310.   GET(245,32)-(298,40),rswitch
  311.   PUT(184,32),swblank,AND
  312.   FOR j=0 TO 20
  313.   LINE(184+j,32)-(193+j,40),3
  314.   NEXT
  315.   LINE(193,39)-(236,40),3,bf
  316.   GET(184,32)-(236,40),lswitch
  317.   FOR m=0 TO 4: FOR n=0TO m+3
  318.   sx=xpos(m,n): sy=ypos(m,n)
  319.   wp=INT(RND(1)*2)
  320.   sw(m,n,0)=wp
  321.   sw(m,n,1)=0
  322.   who=1-who: GOSUB Switch
  323.   NEXT n: NEXT m
  324.   PUT(140,5), larrow
  325.   RETURN
  326.   
  327.   
  328.   
  329.   
  330.   
  331.   
  332.            
  333.   
  334.   
  335.   
  336.   
  337.   
  338.   
  339.   
  340.   
  341.   
  342.   
  343.   
  344.   
  345.   
  346.   
  347.   
  348.   
  349.